Shareware Grab Bag/Shareware Grab Bag.iso/003/pssst.arc/PSMEMJOG.PRG

Text File | 1986-08-18 | 10.0 KB | 383 lines

* PSMEMJOG.PRG
*
* A DBASE II 16BIT COMMAND FILE to allow input or creation of
* filename, and display of suspenses.  This is designed as a stand-alone
* feature of the pSSSt system for automatic display after computer
* bootup.
*
* Version 1
* By LTC Denny Hugg
* ANGSC/DOS Andrews AFB MD 16 Jul 1985
*
* Version 2
* modified by Maj Jim McMurry
* ANGSC/DOSC Truax Field, WI 15 Jun 1986
*
CLEAR
SET TALK OFF
SET BELL OFF
SET COLON OFF
* SET ESCAPE OFF?
ERASE
* --- gflag = 'Y' tells psprompt to put a box around it.  It's the
*     predominant mode
STORE 'Y' TO gflag
* --- an empty string for clearing a specific line
STORE $(STR(1,81),1,80) TO gclearline
STORE '      ' TO gaddstring
USE PSCONFIG.MEM
IF .NOT. model$('ZIO')
* --- use the delete flag to determine that psconfig should return
   USE PSCONFIG.MEM
   DELETE
   USE
   DO PSCONFIG
ENDIF
STORE model to gmodel
STORE 1 TO line
STORE 'SUSPENSE LISTING' to prompt
DO PSPROMPT
* --- turn cursor off for most of program
? gcuroff
* --- namestring is a character field, length 6 in PSCONFIG
IF namestring = '      '
* --- he's configured multi-user
   STORE '               ' TO mfilename
   ? gcuron
   @ 22,18 SAY 'Type in your last name, please ' GET mfilename
   READ
   @  0,0 SAY gcuroff
   @ 22,0 SAY gclearline
   STORE TRIM(mfilename) TO mfilename
* --- create a standard length filename for the guy
   IF LEN(mfilename) < 6
      STORE '000000' TO msixblnks
      STORE $(mfilename,1,LEN(mfilename));
          + $(msixblnks,1,6-LEN(mfilename)) TO mfilename
      STORE $(mfilename,1,6) TO gaddstring
   ELSE
      STORE $(mfilename,1,6) TO gaddstring
   ENDIF
ELSE
* --- he's configured it for single user
   STORE namestring TO gaddstring
ENDIF
* --- create global variables for files and indexes
* --- pssst uses the current year in the filename, this way when the year
* --- changes, you're sent to PSNEWGUY to do some administrative stuff
STORE gaddstring + 'SP.0' + $(DATE(),7,2) TO gsusfile
STORE gaddstring + 'CM.0' + $(DATE(),7,2) TO gcomplfile
STORE gaddstring + 'DD.0' + $(DATE(),7,2) TO gdelfile
* --- indexes named differently ... if the same as the dbf, they'll
* --- eventually scramble things
STORE gaddstring + 'SI' TO gsusindex
STORE gaddstring + 'PI' TO gpryindex
* --- create other global variables from info in PSCONFIG.MEM
STORE TRIM(firstname) TO gfirstname
STORE INT((LEN(gfirstname)/2)+.5) TO gflength
DO CASE
   CASE delays = ' '
      STORE 50 TO gdelay
   CASE delays = 'S'
      STORE 25 TO gdelay
   CASE delays = 'M'
      STORE 50 TO gdelay
   CASE delays = 'L'
      STORE 75 TO gdelay
ENDCASE
* --- convert DATE() to YY/MM/DD so indexing will order them
STORE VAL($(DATE(),1,2)) TO month
STORE VAL($(DATE(),4,2)) TO day
STORE VAL($(DATE(),7,2)) TO year
STORE STR(year,2) TO gdate
IF month > 9
   STORE TRIM(gdate) + '/' + STR(month,2) + '/' TO gdate
ELSE
   STORE gdate + '/0' + STR(month,1) + '/' TO gdate
ENDIF
IF day > 9
   STORE gdate + STR(day,2) TO gdate
ELSE
   STORE gdate + '0' + STR(day,1) TO gdate
ENDIF
* --- check that today's date is later than last date used
* --- last:day is a character field, length 8 in PSCONFIG.MEM
IF gdate < last:day
   DO WHILE gdate < last:day
      STORE gdate TO input
      STORE 10 TO line
      STORE 'You Can Never Go Back ' + gfirstname TO prompt
      DO PSPROMPT
      @  0, 0 SAY curon
      @ 22,19 SAY "You Need To Re-enter Today's Date ";
              GET input PICTURE '99/99/99'
      READ
      @  0, 0 SAY curoff
      @  9, 0 SAY gclearline
      @ 10, 0 SAY gclearline
      @ 11, 0 SAY gclearline
      @ 22, 0 SAY gclearline
      IF input >= last:day
         STORE input TO gdate
      ENDIF
   ENDDO
ENDIF
REPLACE last:day WITH gdate
USE
IF .NOT. FILE ("&gsusfile")
   STORE 10 TO line
   STORE 'You Have No Suspense Files On Record' TO prompt
   DO PSPROMPT
   STORE ' ' TO select
   @ 22,13 SAY 'Would You Like To Enter pSSSt To Create Some? (Y/N) ';
           GET select PICTURE '!'
   READ
   IF select = 'Y'
      DO PSNEWGUY.PRG
      DO PSSST
      @  0, 0 SAY gcuron
      QUIT
   ELSE
      ERASE
      @  0, 0 SAY gcuron
      QUIT
   ENDIF
ENDIF
* --- to determine 7 day suspense taking into account various months
* --- and leap years
STORE VAL($(gdate,1,2)) TO year
STORE VAL($(gdate,4,2)) TO month
STORE VAL($(gdate,7,2)) TO day
DO CASE
   CASE (month = 4 .OR. month = 6) .OR. (month = 9 .OR. month = 11)
      IF day > 23
         STORE day - 23 TO mday
         STORE month + 1 TO mmonth
         STORE year TO myear
      ELSE
         STORE day + 7 TO mday
         STORE month TO mmonth
         STORE year TO myear
      ENDIF
   CASE month = 2
      IF INT(year/4) <> year/4 .OR. INT(year/100) <> 0
         IF day > 21
            STORE day - 21 TO mday
            STORE 3 TO mmonth
            STORE year TO myear
         ELSE
            STORE day + 7 TO mday
            STORE 2 TO mmonth
            STORE year TO myear
         ENDIF
      ELSE
         IF day > 22
            STORE day - 22 TO mday
            STORE 3 TO mmonth
            STORE year TO myear
         ELSE
            STORE day + 7 TO mday
            STORE 2 TO mmonth
            STORE year TO myear
         ENDIF
      ENDIF
   OTHERWISE
      IF day > 24
         STORE day - 24 TO mday
         STORE month + 1 TO mmonth
         STORE year TO myear
      ELSE
         STORE day + 7 TO mday
         STORE month TO mmonth
         STORE year TO myear
      ENDIF
ENDCASE
STORE STR(myear,2) + '/' TO mdate7
IF mmonth > 9
   STORE mdate7 + STR(mmonth,2) + '/' TO mdate7
ELSE
   STORE mdate7 + '0' + STR(mmonth,1) + '/' TO mdate7
ENDIF
IF mday > 9
   STORE mdate7 + STR(mday,2) TO mdate7
ELSE
   STORE mdate7 + '0' + STR(mday,1) TO mdate7
ENDIF
@ 10, 0 SAY gclearline
* --- indexing is more efficient than sorting for the variety of our tasks
USE &gsusfile INDEX &gsusindex
* --- IF EOF
IF # = 0
* --- nobody home so let's go somewhere else
   USE
   STORE 10 to line
   STORE 'NO SUSPENSED ITEMS STORED ' + gfirstname TO prompt
   DO PSPROMPT
   STORE 0 TO mcount
   DO WHILE mcount < gdelay
      STORE mcount + 1 TO mcount
   ENDDO
   ERASE
   ? gcuron
   QUIT
ENDIF
* --- display suspenses
STORE 20 TO mpagelen
* --- find overdue stuff
STORE 0 TO mpasses
@ 3, 0 SAY 'DUE DATE'
@ 3,10 SAY 'SUSPENSE ITEM'
@ 3,66 SAY 'TASKED BY'
@ 4, 0 SAY gline
STORE 5 TO mline
@ mline, 10 SAY 'Overdue Items:'
STORE mline + 1 TO mline
DO WHILE .NOT. EOF
   IF mline > mpagelen
      @ 22,21 SAY "- Please Strike Any Key To Continue -"
      SET CONSOLE OFF
      WAIT
      SET CONSOLE ON
      ERASE
      @ 3, 0 SAY 'DUE DATE'
      @ 3,10 SAY 'SUSPENSE ITEM'
      @ 3,66 SAY 'TASKED BY'
      @ 4, 0 SAY gline
      STORE 5 TO mline
   ENDIF
   IF gdate > duedate
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
   ENDIF
   SKIP
ENDDO gdate > duedate
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,26 SAY "None"
   STORE mline + 1 TO mline
ENDIF
STORE mline + 1 TO mline
GO TOP
* --- find stuff due today
STORE 0 TO mpasses
@ mline, 10 SAY 'Items Due Today:'
STORE mline + 1 TO mline
DO WHILE .NOT. EOF
   IF mline > mpagelen
      @ 22,21 SAY "- Please Strike Any Key To Continue -"
      SET CONSOLE OFF
      WAIT
      SET CONSOLE ON
      ERASE
      @ 3, 0 SAY 'DUE DATE'
      @ 3,10 SAY 'SUSPENSE ITEM'
      @ 3,66 SAY 'TASKED BY'
      @ 4, 0 SAY gline
      STORE 4 TO mline
   ENDIF
   IF gdate = duedate
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
   ENDIF
   SKIP
ENDDO  gdate = duedate
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,28 SAY 'None'
   STORE mline + 1 TO mline
ENDIF
STORE mline + 1 TO mline
* --- find stuff due in next 7 days
GO TOP
STORE 0 TO mpasses
@ mline, 10 SAY 'Items Due In The Next 7 Days:'
STORE mline + 1 TO mline
DO WHILE .NOT. EOF
   IF mline > mpagelen
      @ 22,21 SAY "- Please Strike Any Key To Continue -"
      SET CONSOLE OFF
      WAIT
      SET CONSOLE ON
      ERASE
      @ 3, 0 SAY 'DUE DATE'
      @ 3,10 SAY 'SUSPENSE ITEM'
      @ 3,66 SAY 'TASKED BY'
      @ 4, 0 SAY gline
      STORE 5 TO mline
   ENDIF
   IF gdate < duedate .AND. duedate <= mdate7
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
   ENDIF
   SKIP
ENDDO next 7 days
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,41 SAY 'None'
   STORE mline + 1 TO mline
ENDIF
STORE mline + 1 TO mline
STORE 0 TO mpasses
@ mline, 10 SAY 'Other Suspenses Facing You:'
STORE mline + 1 TO mline
GO TOP
* --- find stuff due after next week
DO WHILE .NOT. EOF
   IF mline > mpagelen
      @ 22,21 SAY "- Please Strike Any Key To Continue -"
      SET CONSOLE OFF
      WAIT
      SET CONSOLE ON
      ERASE
      @ 3, 0 SAY 'DUE DATE'
      @ 3,10 SAY 'SUSPENSE ITEM'
      @ 3,66 SAY 'TASKED BY'
      @ 4, 0 SAY gline
      STORE 5 TO mline
   ENDIF
   IF duedate > mdate7
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY origin
      STORE mline + 1 TO mline
      STORE mpasses + 1 TO mpasses
   ENDIF
   SKIP
ENDDO suspenses beyond a week
IF mpasses = 0
   STORE mline - 1 TO mline
   @ mline,39 SAY 'None'
   STORE mline + 1 TO mline
ENDIF
USE
@ 22,21 SAY "- Please Strike Any Key To Continue -"
SET CONSOLE OFF
WAIT
SET CONSOLE ON
@ 22, 0 SAY gclearline
STORE ' ' TO select
@ 22,14 SAY 'Do You Want To Enter pSSSt For Data Update? (Y/N) ';
        GET select PICTURE '!'
READ
IF select = 'Y'
   RELEASE ALL EXCEPT g*
   DO PSSST
ELSE
   ERASE
   @ 0, 0 SAY gcuron
   QUIT
ENDIF
* EOF PSMEMJOG.PRG
 .AND. duedate <= mdate7
      @ mline, 0 SAY duedate
      @ mline,10 SAY descrip
      @ mline,66 SAY ori